Entrega grupal

Eli, Jazmín, Shengnan, Flor, Mariajo

Paquetes necesarios

Code

rm(list = ls())
library(tidyverse)
library(glue)
library(forcats)
library(lubridate)
library(waffle)
library(ggpol)
library(ggforce)
library(sf) # para importar archivos shapefiles
library(broom) # Para transformar los archivos shapefiles 
library(gridExtra)
library(grid)
library(gganimate)

Datos empleados

Code

shapefile_provincias <- st_read("./data/archivomapa/Provincias_ETRS89_30N.shp")

Reading layer `Provincias_ETRS89_30N' from data source 
  `C:\Users\jazmi\Desktop\GITHUB\software\data\archivomapa\Provincias_ETRS89_30N.shp' 
  using driver `ESRI Shapefile'
Simple feature collection with 52 features and 5 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -1004502 ymin: 3132137 xmax: 1126932 ymax: 4859240
Projected CRS: ETRS89 / UTM zone 30N

Code

election_data <- read_csv(file = "./data/datos_elecciones_brutos.csv")
cod_mun <- read_csv(file = "./data/cod_mun.csv")
surveys <- read_csv(file = "./data/historical_surveys.csv")
abbrev <- read_csv(file = "./data/siglas.csv")
escannos_provincia_anno <- read_csv("data/escannos_provincia_anno.csv")

Parte 1: Depuración de datos

Debes trabajar únicamente en el período de tiempo que incluye las elecciones desde 2008 hasta las últimas elecciones de 2019

Solo nos interesarán los siguientes partidos: - PARTIDO SOCIALISTA OBRERO ESPAÑOL - PARTIDO POPULAR - CIUDADANOS - PARTIDO NACIONALISTA VASCO - BLOQUE NACIONALISTA GALLEGO - UNIDAS PODEMOS - IU (Unidas Podemos, Unidos Podemos, Podemos, IU, Podem, y Ezker Batua). - ESQUERRA REPUBLICANA DE CATALUNYA - EH - BILDU (ahora son una coalición de partidos formada por lo que antes era Sortu, Eusko Alkartasuna, Aralar, Alternatiba). - VOX

Todo lo que no esté en alguno de los anteriores partidos debe ser correctamente reagrupado (y resumido) en OTROS

Convertir a tidy data

Code

#Convertir a tidy data
eleccion_tidy <- 
  election_data |> 
  pivot_longer(cols = c(16:471), 
               names_to = "partido", 
               values_to = "votos", 
               values_drop_na = TRUE)

eleccion_tidy |> 
  distinct(codigo_distrito_electoral) #Sólo está el 0

# A tibble: 1 × 1
  codigo_distrito_electoral
                      <dbl>
1                         0

Code

eleccion_tidy |> 
  distinct(vuelta) #Sólo vuelta 1

# A tibble: 1 × 1
  vuelta
   <dbl>
1      1

Code

eleccion_tidy |> 
  distinct(tipo_eleccion) #Sólo tipo 02 --> nacionales

# A tibble: 1 × 1
  tipo_eleccion
  <chr>        
1 02

Code

eleccion_tidy |> 
  distinct(anno, mes) #Hubo 6 elecciones : 2008,2011,2015,2016,2019 (abril) y 2019 (noviembre)

# A tibble: 6 × 2
   anno mes  
  <dbl> <chr>
1  2008 03   
2  2011 11   
3  2015 12   
4  2016 06   
5  2019 04   
6  2019 11

Depuración nombres de partidos

#Depuración nombres de partidos
nombres_partidos <- c("PARTIDO SOCIALISTA OBRERO ESPAÑOL","PARTIDO POPULAR", "CIUDADANOS", "PARTIDO NACIONALISTA VASCO", "BLOQUE NACIONALISTA GALLEGO", "UNIDAS PODEMOS - IU", "ESQUERRA REPUBLICANA DE CATALUNYA",  "EH - BILDU", "VOX")

cambia_nombres <- function(partido, nombres) {
  partido_min <- str_to_lower(partido)
  nombres_min <- str_to_lower(nombres)
  
  if (str_detect(partido_min, "\\bsortu\\b|\\beusko alkartasuna\\b|\\baralar\\b|\\balternatiba\\b|\\beuskal herria bildu\\b")) { 
    #Añado el nombre completo de EH - Bildu y cambio a str_detect porque antes no captaba todo lo que debía (ej 2008, Victoria-Gasteiz EZKER BATUA-BERDEAK-ALTERNATIVA)
    return("EH - BILDU")
  }
  
   if (str_detect(partido_min, "\\bunidas podemos\\b|\\bunidos podemos\\b|\\bpodemos\\b|\\biu\\b|\\bpodem\\b|\\bezker batua\\b")) {
    return("UNIDAS PODEMOS - IU")
  }
  
  if (str_detect(partido_min,"\\bpartido nacionalista vasco\\b")) {
    return("PARTIDO NACIONALISTA VASCO")
  }
  
  if (str_detect(partido_min,"\\bpsoe\\b|\\bpartido socialista obrero español\\b\\bpartido socialista de euskadi\\b|\\bpartit dels socialistes de catalunya\\b|\\bpartido dos socialistas de galicia\\b")) {
    return("PARTIDO SOCIALISTA OBRERO ESPAÑOL")
  }
  
    if (str_detect(partido_min,"\\bpp\\b|\\bpartido popular\\b")) {
    return("PARTIDO POPULAR")
    }
  
  if (str_detect(partido_min,"\\bbloque nacionalista galego\\b")) {
    return("BLOQUE NACIONALISTA GALLEGO")  
  }
  
  if (str_detect(partido_min,"\\bpartido de la ciudadanía\\b|\\bpartido de la ciudadania\\b")) {
    return("CIUDADANOS")  
  }
  
  if (str_detect(partido_min,"\\besquerra republicana de catalunya\\b")) { #Nótese que quedan aún partidos tipo coalición (considero que deberían incluirse)
    return("ESQUERRA REPUBLICANA DE CATALUNYA")  
  }
  
  if (any(partido_min == nombres_min)) {
    return(partido)  
  }
  
  return("OTRO")
}

cambia_nombres("PARTIDO MINERO POPULAR", nombres_partidos) #ejemplo

[1] "OTRO"

cambia_nombres("PARTIT POPUPLR-PARTIDO POPULAR", nombres_partidos) #ejemplo

[1] "PARTIDO POPULAR"

cambia_nombres("CIUDADANOS-PARTIDO DE LA CIUDADANÍA", nombres_partidos) #ver que antes no captaba

[1] "CIUDADANOS"

#Aplicar función al dataframe
eleccion_tidy_filt <- 
  eleccion_tidy |> 
  rowwise() |> 
  mutate(partido_n = cambia_nombres(partido, nombres_partidos))

#Reagrupar partido "otro"
eleccion_resumen <- 
  eleccion_tidy_filt |>
  group_by(partido_n,anno,mes,codigo_ccaa,codigo_provincia,codigo_municipio) |> 
  mutate(votos_totales_partido = sum(votos)) |> 
  ungroup() # Ver anotaciones del cambio

Encuestas

Debes descartar las encuestas que:

-   se refieran a elecciones anteriores a 2008
-   sean a pie de urna
-   tamaño muestral desconocido o inferior a 500.
-   tenga 1 día o menos de trabajo de campo.

Code

surveys_tidy <- 
  surveys |> 
  pivot_longer(cols = c(11:59), 
               names_to = "partidos", 
               values_to = "intencion_voto", 
               values_drop_na = TRUE) |>
  drop_na(size) |>  
  filter(size >=500 & exit_poll == FALSE) |>   #tamaño muestral y a pie de urna
  filter(date_elec >= "2008-01-01") |>  #elecciones desde 2008
  mutate(duracion_t_campo = field_date_to - field_date_from) |> 
  filter(duracion_t_campo > 1) |> #descartar enucentas con 1 días o menos de trabajo de campo
  select(-exit_poll) |>  #quitar var. a pie de urna porque no es informativa (sólo quedan las que no lo)
  mutate(siglas = case_when(
            partidos == "PSOE" ~ "PSOE",
            partidos == "PP" ~ "PP",
            partidos == "CC" ~ "C's",
            partidos == "BNG" ~ "BNG",
            partidos == "ERC" ~ "ERC",
            partidos == "IU" ~ "PODEMOS-IU",
            partidos == "UP" ~ "PODEMOS-IU",
            partidos == "PODEMOS" ~ "PODEMOS-IU",
            partidos == "EH-BILDU" ~ "EH-BILDU",
            partidos == "EAJ-PNV" ~ "PNV",
            partidos == "VOX" ~ "VOX",
            TRUE ~ "OTRO" ))

Resumen de información

Code

# Tabla maestra que contiene nombres de municipios, sus códigos y las siglas de cada partido (para facilitar la visualización)

abbrev_modif <- abbrev|> 
  rowwise() |> 
  mutate(partidos = cambia_nombres(denominacion, nombres_partidos)) |> 
  select(-denominacion) |> 
  distinct(partidos, .keep_all = TRUE) |> 
  mutate(siglas = case_when(
    partidos == "PARTIDO NACIONALISTA VASCO"  ~ "PNV",
    partidos == "PARTIDO SOCIALISTA OBRERO ESPAÑOL"  ~ "PSOE",
    partidos == "UNIDAS PODEMOS - IU" ~ "PODEMOS-IU",
    partidos == "EH - BILDU" ~ "EH-BILDU",
    partidos == "OTRO"  ~ "OTRO",
    TRUE ~ siglas))

tabla_maestra <-
  eleccion_resumen |> 
  unite(col = "cod_poblacion", codigo_ccaa, codigo_provincia, codigo_municipio, sep = "-", remove = FALSE) |> 
  left_join(cod_mun, by =  c("cod_poblacion" = "cod_mun")) |> 
  select(-c(tipo_eleccion,vuelta)) |> 
  left_join(abbrev_modif, by = c("partido_n" = "partidos"))

Resultados generales de las elecciones

Code

# Preparamos los resultados de las elecciones, vemos qué porcentaje de votos ha ido a cada partido

datos_generales_elecciones <- 
  tabla_maestra |>
  group_by(anno,mes) |> 
  distinct(anno, mes, cod_poblacion, codigo_ccaa, codigo_provincia, codigo_municipio, codigo_distrito_electoral, censo, votos_blancos, votos_nulos, votos_candidaturas) |> 
  mutate(censo = sum(censo),
         votos_blancos = sum(votos_blancos),
         votos_nulos = sum(votos_nulos),
         votos_candidaturas = sum(votos_candidaturas),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, censo, votos_blancos, votos_nulos, votos_candidaturas) 

datos_partido <-
  tabla_maestra |> 
  group_by(anno, mes, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, siglas, votos_partido) |> 
  left_join(datos_generales_elecciones, by = c("eleccion" = "eleccion")) |> 
  mutate(votos_porc_votantes_cand = round(votos_partido / votos_candidaturas, 2), # Porcentaje sobre la gente que voto candidaturas
         votos_porc_censo = round(votos_partido / censo, 2)) # Porcentaje sobre la gente censada,

datos_partido <-
  datos_partido |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE)) 

#Colores de partidos
colores_partidos <- c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                      "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                      "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                      "C's" = "#fb5000")

#Resultados generales
grafico_resultados_elecciones <- 
  ggplot(datos_partido, aes(x = eleccion, y = votos_porc_votantes_cand, fill = siglas)) +
  geom_col(position = "fill") +
    geom_text(
    aes(
      label = ifelse(votos_porc_votantes_cand > 0.08, scales::percent(votos_porc_votantes_cand, accuracy = 1), ""),
      y = votos_porc_votantes_cand / 2
    ),
    position = position_fill(vjust = 0.5),
    size = 3,
    color = "white"
  ) +
  scale_fill_manual(values = colores_partidos) +
  labs(
    title = "Resultados generales",
    x = "Elecciones",
    y = "Porcentaje de votos",
    fill = "Partido"
  ) +
  theme_minimal()

grafico_resultados_elecciones

Mapa

Code

provincias_sf <- st_as_sf(shapefile_provincias)

mas_votado_prov <-
  tabla_maestra |> 
  group_by(anno, mes, codigo_provincia, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  filter(eleccion == "2015") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov <-
  mas_votado_prov |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf <- 
  provincias_sf %>%
  left_join(mas_votado_prov, by = c("Codigo" = "codigo_provincia"))

head(provincias_sf)

Simple feature collection with 6 features and 10 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 121464.4 ymin: 4059438 xmax: 781036.7 ymax: 4784875
Projected CRS: ETRS89 / UTM zone 30N
  Codigo    Texto Texto_Alt Cod_CCAA                 CCAA eleccion     siglas
1     01    Álava     Araba       16           País Vasco     2015 PODEMOS-IU
2     02 Albacete  Albacete       08 Castilla - La Mancha     2015         PP
3     03 Alicante   Alacant       10 Comunitat Valenciana     2015         PP
4     04  Almería   Almería       01            Andalucía     2015         PP
5     05    Ávila     Ávila       07      Castilla y León     2015         PP
6     06  Badajoz   Badajoz       11          Extremadura     2015       PSOE
  votos_partido votos_totales      porc                       geometry
1         48266        177448 0.2720008 MULTIPOLYGON (((497823.7 47...
2         85152        229154 0.3715929 MULTIPOLYGON (((630529.3 43...
3        296709        897466 0.3306075 MULTIPOLYGON (((720290.8 42...
4        117407        306446 0.3831246 MULTIPOLYGON (((572241.6 40...
5         46963        100859 0.4656302 MULTIPOLYGON (((331047.9 45...
6        148347        395612 0.3749810 MULTIPOLYGON (((355598.1 43...

Code

grafico_pais <-
  ggplot(data = provincias_sf) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) +  # Escala de colores
  theme_minimal() +
  labs(title = "Mapa de España con datos por provincia",
       fill = "Leyenda")

grafico_pais

Parte 2: Votos en los municipios grandes (>100.000 habitantes)

Code

# DATOS PREGUNTA 1
datos_p1 <- 
  tabla_maestra |> #Una fila por municipio
  filter(censo > 100000) |> #Condición del censo
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> #Partido más votado por elección
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  #Quito filas repetidas (partidos resultantes de la agrupación)
  group_by(anno, mes) |> 
  count(siglas) |> #Por elección cuento nº de veces qeu aparece el partido como más votado (=nº de municipios donde ganó) 
  ungroup() |> 
  mutate(
    siglas = factor(siglas, levels = unique(siglas)), # Aseguramos el orden
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

plot_p1 <- ggplot(datos_p1, aes(fill = siglas, values = n)) +
  geom_waffle(n_rows = 10) +
  facet_grid(~eleccion) +
  scale_fill_manual(values = colores_partidos) +
  labs(title = "Partidos ganadores en municipios con >100.000 habitantes",
         fill = "Partido") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    axis.text = element_blank(),
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank())

Code

plot_p1

Parte 2: ¿Qué partido fue el segundo cuando el primero fue el PSOE?

Code

# DATOS PREGUNTA 2

datos_p2_previo <-
  tabla_maestra |>
  filter(censo > 100000) |> 
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas)

# Apartado a: El PSOE es el primer partido

datos_p2_psoe_prim <-
  datos_p2_previo |> 
  filter(siglas == "PSOE")

datos_p2_a <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_psoe_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PSOE es el primero
plot_p2_a <- datos_p2_a |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PSOE",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")

datos_p2_pp_prim <-
  datos_p2_previo |> 
  filter(siglas == "PP")

datos_p2_b <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_pp_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PP es el primero
plot_p2_b <- datos_p2_b |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PP",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")

Code

plot_p2_a

Code

plot_p2_b

Parte 3

Code

tabla_pg4 <- 
  tabla_maestra |>
  # Votos totales por población
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

tabla_pg4_censo <-
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

tabla_pg4_censoxvotos <-
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(
    porc = votos_tot / censo_tot,
    comunidad_autonoma = case_when(
      codigo_ccaa == "01" ~ "Andalucia",
      codigo_ccaa == "02" ~ "Aragon",
      codigo_ccaa == "03" ~ "Asturias",
      codigo_ccaa == "04" ~ "Baleares",
      codigo_ccaa == "05" ~ "Canarias",
      codigo_ccaa == "06" ~ "Cantabria",
      codigo_ccaa == "07" ~ "Castilla y Leon",
      codigo_ccaa == "08" ~ "Castilla La Mancha",
      codigo_ccaa == "09" ~ "Cataluña",
      codigo_ccaa == "10" ~ "Comunidad Valenciana",
      codigo_ccaa == "11" ~ "Extremadura",
      codigo_ccaa == "12" ~ "Galicia",
      codigo_ccaa == "13" ~ "Comunidad de Madrid",
      codigo_ccaa == "14" ~ "Murcia",
      codigo_ccaa == "15" ~ "Navarra",
      codigo_ccaa == "16" ~ "País Vasco",
      codigo_ccaa == "17" ~ "La Rioja",
      codigo_ccaa == "18" ~ "Ceuta",
      TRUE ~ "Melilla"
    )
  )

# Graficar los datos
ggplot(tabla_pg4_censoxvotos) +
  geom_line(aes(x = anno, y = porc, color = comunidad_autonoma), size = 0.7, alpha = 0.8) +
  scale_x_continuous(
    breaks = seq(2007, 2020, by = 1), 
    labels = seq(2007, 2020, by = 1)
  ) +
  scale_color_viridis_d() + 
  labs(
    title = "Relación entre Votos Totales y Censo Total por Comunidad Autónoma",
    x = "Año",
    y = "Porcentaje de Votos sobre Censo",
    color = "Comunidad Autónoma"
  ) +
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9)
  )

Code

#Se observa como el porcentaje de votos respecto al censo fue disminuyendo alrededor del 2015 para la mayoría de comunidades, seguido de una recuperacíon en los años posteriores (hacia 2017-2018).

#Las comunidades tienen diferentes niveles de participación. Algunas mantienen un porcentaje más alto (cerca del 80%), mientras que otras caen a valores significativamente más bajos (alrededor del 50% en algunos años).

Parte 3: Evolución del Porcentaje de Voto en Relación al Censo por Comunidad Autónoma

Code

# Crear tabla con votos totales por población
tabla_pg4 <- 
  tabla_maestra |>
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

# Crear tabla con el censo
tabla_pg4_censo <- 
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

# Unir las dos tablas y calcular porcentaje de votos sobre censo
tabla_pg4_censoxvotos <- 
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(porc = votos_tot / censo_tot,
         comunidad_autonoma = case_when(
           codigo_ccaa == "01" ~ "Andalucia",
           codigo_ccaa == "02" ~ "Aragon",
           codigo_ccaa == "03" ~ "Asturias",
           codigo_ccaa == "04" ~ "Baleares",
           codigo_ccaa == "05" ~ "Canarias",
           codigo_ccaa == "06" ~ "Cantabria",
           codigo_ccaa == "07" ~ "Castilla y Leon",
           codigo_ccaa == "08" ~ "Castilla La Mancha",
           codigo_ccaa == "09" ~ "Catalunya",
           codigo_ccaa == "10" ~ "Comunidad Valenciana",
           codigo_ccaa == "11" ~ "Extremadura",
           codigo_ccaa == "12" ~ "Galicia",
           codigo_ccaa == "13" ~ "Comunidad de Madrid",
           codigo_ccaa == "14" ~ "Murcia",
           codigo_ccaa == "15" ~ "Navarra",
           codigo_ccaa == "16" ~ "Pais Vasco",
           codigo_ccaa == "17" ~ "La Rioja",
           codigo_ccaa == "18" ~ "Ceuta",
           TRUE ~ "Melilla"
         )) |> 
  group_by(codigo_ccaa) |> 
  mutate(mean_porc = mean(porc),
         tipos_ccaa = case_when(
           mean_porc > 0.74 ~ "Porc > 0.73",
           mean_porc > 0.71 ~ "Porc > 0.71 y < 0.73",
           mean_porc > 0.6 ~ "Porc > 0.6 y < 0.71",
           TRUE ~ "Porc <= 0.6"
         ))

# Graficar los datos
ggplot(tabla_pg4_censoxvotos) +
  geom_line(aes(x = anno, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +
  scale_x_continuous(
    breaks = seq(2007, 2018, by = 3), 
    labels = seq(2007, 2018, by = 3)
  ) +
  scale_color_viridis_d() +  # Utilizar la paleta viridis
  labs(
    title = "Relación entre Censo y Voto por Comunidad Autónoma",
    x = "Año", 
    y = "Porcentaje de Voto",
    color = "Comunidad Autónoma"
  ) +
  facet_wrap(~ tipos_ccaa) +  # Dividir en facetas por tipo de porcentaje
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9)
  )

Code

#Se observan disparidades en la participación electoral por comunidad autónoma, con Ceuta y Melilla (\<60 %) en el nivel más bajo y comunidades como La Rioja y País Vasco (\> 70%) en el más alto.

#Las regiones con menor participación muestran cierta recuperación hacia 2018, mientras que las comunidades con alta participación mantienen estabilidad a lo largo del tiempo.

Parte 3: ¿Es cierto que determinados partidos ganan en las zonas rurales?

tabla_maestra <- tabla_maestra |> 
  mutate(zona = case_when(
    censo < 10000 ~ "rural",  
    TRUE ~ "urbano"
  ))
# Análisis de partidos ganadores en zonas rurales
datos_rurales <- 
  tabla_maestra |>  
  filter(zona == "rural") |>  
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |>  
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  
  group_by(anno, mes) |>  
  count(siglas) |>  
  ungroup() |>  
  mutate(
    siglas = factor(siglas, levels = unique(siglas)),  
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ "2019 (abril)",
      anno == 2019 & mes == "11" ~ "2019 (noviembre)"
    )
  )

datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f","VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")

# Partidos ganadores en zonas rurales por año
datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales por Año",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  facet_wrap(~ eleccion) +  
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")

Parte 4

¿Cómo calibrar el error de las encuestas (recordemos que las encuestas son de intención de voto a nivel nacional)?

Podemos ver que los resultados de las encuestas se suelen desviar entre cero con algo y 2 puntos porcentuales

Code

# Preparamos los datos de las encuestas, vemos qué porcentaje de votantes se estiman para cada partido

surveys_general <-
  surveys_tidy |> 
  distinct(date_elec, pollster, field_date_from, field_date_to, size, turnout) |> 
  mutate(personas_turnout = round((size * turnout)/100),0) |> 
  group_by(date_elec, pollster) |> 
  mutate(size = sum(size),
         personas_turnout = sum(personas_turnout, na.rm = TRUE),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)")) |> 
  distinct(eleccion, pollster, size, personas_turnout)
  
surveys_partido <-
  surveys_tidy |> 
  mutate(votantes = round(((size - turnout)*intencion_voto)/100, 0)) |> 
  group_by(date_elec, pollster, siglas) |> 
  mutate(votantes_estimados = sum(votantes, na.rm = TRUE)) |> 
  distinct(date_elec, pollster, siglas, votantes_estimados) |> 
  left_join(surveys_general, by = c("date_elec" = "date_elec", "pollster" = "pollster")) |> 
  mutate(votos_porc_votantes_cand = round(votantes_estimados / (size - personas_turnout), 2),
         votos_porc_censo = round(votantes_estimados / size, 2),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)"))  |> 
  group_by(eleccion, siglas) |> 
  mutate(media_porc_encuesta = mean(votos_porc_votantes_cand)) |> 
  ungroup()

# Comparamos los datos reales vs los de las encuestas

comparacion <- 
  left_join(x = surveys_partido, y = datos_partido, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |> 
  select (eleccion, pollster, siglas, votos_porc_votantes_cand.x, votos_porc_votantes_cand.y, votos_porc_censo.x, votos_porc_censo.y) |> 
  mutate(error_relativo_cand = abs(votos_porc_votantes_cand.y - votos_porc_votantes_cand.x) / votos_porc_votantes_cand.y,
         error_relativo_censo = abs(votos_porc_censo.y - votos_porc_censo.x) / votos_porc_censo.y,
         error_real = (votos_porc_votantes_cand.x - votos_porc_votantes_cand.y) / votos_porc_votantes_cand.y ,
         error_positivo_negativo = case_when (error_real >=0 ~ "Positivo", TRUE ~ "Negativo")) |> 
  drop_na(eleccion)

Code

# Propuesta 0 : caja y bigotes

grafico_comparacion_partido <-
  ggplot(comparacion, aes(x = error_relativo_cand, y = siglas, fill = siglas)) +
  geom_boxplot() +
  facet_wrap(~eleccion) +
  scale_fill_manual(values = colores_partidos)  +
    labs(
    x = "Error absoluto relativo",
    y = "Partido",
    fill = "Partido"
  ) +
  guides(fill = "none")
grafico_comparacion_partido

(Para eliminar)

Code

# Propuesta 1 : barras

error_positivo_negativo <-
  comparacion |> 
  group_by(pollster) |> 
  count(error_positivo_negativo) |> 
  mutate(totales = sum(n),
         porc = round(n / totales,1))

orden_pollsters <-
  error_positivo_negativo |> 
  filter(error_positivo_negativo == "Negativo") |> 
  arrange(-porc) |> 
  select(pollster) |> 
  pull()

error_positivo_negativo <-
  error_positivo_negativo |> 
  mutate(pollster = factor(pollster, levels = orden_pollsters, ordered= TRUE))

ggplot(error_positivo_negativo) + 
  geom_col(aes( y = pollster, x = porc, fill = error_positivo_negativo)) +
    theme(axis.text.y = element_text(size = 7))

Para eliminar

Code

# Propuesta 2 : lollipop

# Partido que ganó las elecciones
datos_partido_ganador <- 
  datos_partido |> 
  group_by(eleccion) |> 
  slice_max(votos_partido)

comparacion_filtro <- 
  comparacion |> 
  inner_join(y = datos_partido_ganador, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |> 
  filter(eleccion == "2019 (noviembre)") |> 
  select(eleccion, pollster, error_real)

orden_pollsters2 <-
  comparacion_filtro |> 
  arrange(- error_real) |> 
  select(pollster) |> 
  pull()

comparacion_filtro <-
  comparacion_filtro |> 
  mutate(pollster = factor(pollster, levels = orden_pollsters2, ordered = TRUE))
  
ggplot(comparacion_filtro, aes(x = pollster, y = error_real)) +
  geom_segment( aes(x = pollster, xend = pollster, y=0, yend = error_real), color="grey", size = 1.2) +
  geom_point( color="orange", size = 4) +
  facet_wrap(~ eleccion) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  xlab("") +
  ylab("Desviación porc. de los votos reales") +
  coord_flip()

Code

# Propuesta 3: lollipop por años con el promedio

comparacion_filtro3 <- 
  comparacion |> 
  inner_join(y = datos_partido_ganador, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |>
  group_by(eleccion) |> 
  mutate(promedio_error = mean(error_real)) |> 
  distinct(eleccion, promedio_error)


ggplot(comparacion_filtro3, aes(x = eleccion, y = promedio_error)) +
  geom_segment( aes(x = eleccion, xend = eleccion, y=0, yend = promedio_error), color="grey", size = 1.2) +
  geom_point( color="orange", size = 4) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  xlab("") +
  ylab("Desviación porc. de los votos reales") +
  coord_flip()

Parece que hay algunas empresas encuestadoras que se desvían más que otras, ver cómo poner este gráfico por años

(Para eliminar)

Code

# Propuesta 4: cajas y bigotes por encuestadora
grafico_comparacion_pollster <-
  comparacion |> 
  filter(eleccion == "2015") |> 
  ggplot( aes(x = error_relativo_cand, y = pollster, fill = pollster)) +
  geom_boxplot() +
  labs(
    x = "Error absoluto relativo",
    y = "Encuestadora",
    fill = "Encuestadora"
  ) +
  guides(fill = "none") +
  facet_wrap(~eleccion) 
grafico_comparacion_pollster

Parte 4

¿La intención de voto reportada en las encuestas muestra tendencias consistentes con las tasas de participación reales en todas las elecciones?

Code

participacion_actual <- tabla_maestra |> 
  group_by(anno, mes) |> 
  summarise(
    censo_total = sum(censo, na.rm = TRUE),
    votos_candidaturas_total = sum(votos_candidaturas, na.rm = TRUE),
    .groups = "keep"
  ) |>
  mutate(participacion_rate_actual = votos_candidaturas_total / censo_total)


participacion_actual <- participacion_actual |> 
  mutate(
    year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d")
  )


ggplot(participacion_actual, aes(x = year_month, y = participacion_rate_actual)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Porcentaje de participación real por año y mes",
    x = "Año-Mes",
    y = "Porcentaje de participación (Actual)"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_actual$year_month  
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1), 
    legend.position = "none"
  )

Code

survey_participacion_month <- surveys_tidy |> 
  mutate(
    anno = year(as.Date(date_elec)),  
    mes = month(as.Date(date_elec))  
  ) |> 
  group_by(anno, mes) |> 
  summarise(
    turnout_mean = mean(turnout, na.rm = TRUE), 
    .groups = "drop"
  ) |> 
  mutate(year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d"))

ggplot(survey_participacion_month, aes(x = year_month, y = turnout_mean)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Participación electoral promedio por año y mes",
    x = "Año-Mes",
    y = "Participación media (%)"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = survey_participacion_month$year_month) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) 
  )

Code

participacion_diff <- left_join(
  participacion_actual, survey_participacion_month, by = "year_month"
) |> 
  mutate(
    participacion_diff = participacion_rate_actual - (turnout_mean / 100)
  )

ggplot(participacion_diff, aes(x = year_month, y = participacion_diff)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_diff$year_month) +
  labs(
    title = "Diferencia entre las tasas de participación reales y previstas",
    x = "Año-Mes",
    y = "Diferencia en el porcentaje de participación (real - prevista)"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) 
  )

Parte 5

¿Cómo se distribuyeron los escaños en cada elección?

Code

# Preparación para gráfico escaños

datos_elecciones_provincia <- 
  tabla_maestra |>
  group_by(anno, mes, codigo_provincia) |> 
  distinct(anno, mes, codigo_provincia, votos_blancos, votos_candidaturas) |> 
  mutate(votos_blancos = sum(votos_blancos),
         votos_candidaturas = sum(votos_candidaturas),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, codigo_provincia, votos_blancos, votos_candidaturas) 

datos_partido_provincia <-
  tabla_maestra |> 
  group_by(anno, mes, codigo_provincia,  partido) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(anno, eleccion, codigo_provincia, partido, votos_partido) 
  #left_join(datos_elecciones_provincia, by = c("eleccion" = "eleccion", "codigo_provincia" = "codigo_provincia")) |> 
  #mutate(porc_votos_validos = round(votos_partido / (votos_candidaturas + votos_blancos), 2)) # % votos de la provincia
  #filter(porc_votos_validos >= 0.03)   # Para participar en D'Hondt 


# datos_partido_provincia |> 
#   group_by(eleccion, partido) |> 
#   summarise(suma = sum(votos_partido)) |> 
#   ungroup() |> 
#   write.csv(file="votos_partidos.csv")


# Importamos el número de escaños por provincia y año

escannos_provincia_anno <- read_csv("data/escannos_provincia_anno.csv")

escannos_provincia_anno <-
  escannos_provincia_anno |> 
  mutate(codigo_provincia = as.character(case_when(
          Provincia == "Madrid" ~ "28",
          Provincia == "Barcelona" ~ "08",
          Provincia == "Valencia" ~ "46",
          Provincia == "Sevilla" ~ "41",
          Provincia == "Alicante" ~ "03",
          Provincia == "Málaga" ~ "29",
          Provincia == "Murcia" ~ "30",
          Provincia == "Cádiz" ~ "11",
          Provincia == "Baleares" ~ "07",
          Provincia == "La Coruña" ~ "15",
          Provincia == "Las Palmas" ~ "35",
          Provincia == "Asturias" ~ "33",
          Provincia == "Granada" ~ "18",
          Provincia == "Pontevedra" ~ "36",
          Provincia == "Santa Cruz de Tenerife" ~ "38",
          Provincia == "Zaragoza" ~ "50",              
          Provincia == "Almería" ~ "04",
          Provincia == "Córdoba" ~ "14",
          Provincia == "Gerona" ~ "17",
          Provincia == "Guipúzcoa" ~ "20",
          Provincia == "Tarragona" ~ "43",
          Provincia == "Toledo" ~ "45",
          Provincia == "Badajoz" ~ "06",
          Provincia == "Cantabria" ~ "39",
          Provincia == "Castellón" ~ "12",
          Provincia == "Ciudad Real" ~ "13",
          Provincia == "Huelva" ~ "21",
          Provincia == "Jaén" ~ "23",
          Provincia == "Navarra" ~ "31",
          Provincia == "Valladolid"  ~ "47",
          Provincia == "Álava" ~ "01",
          Provincia == "Albacete" ~ "02",
          Provincia == "Burgos" ~ "09",
          Provincia == "Cáceres" ~ "10",
          Provincia == "León" ~ "24",
          Provincia == "Lérida"  ~ "25",
          Provincia == "Lugo" ~ "27",
          Provincia == "Orense" ~ "32",
          Provincia == "La Rioja" ~ "26",
          Provincia == "Salamanca"  ~ "37",
          Provincia == "Ávila" ~ "05",
          Provincia == "Cuenca" ~ "16",
          Provincia == "Guadalajara" ~ "19",
          Provincia == "Huesca"  ~ "22",
          Provincia == "Palencia"  ~ "34",
          Provincia == "Segovia" ~ "40",
          Provincia == "Teruel" ~ "44",
          Provincia == "Vizcaya" ~ "48",
          Provincia == "Zamora" ~ "49",
          Provincia == "Soria" ~ "42",
          Provincia == "Ceuta" ~ "51",
          Provincia == "Melilla" ~ "52"))) |> 
  distinct() 


datos_provincia_escannos <-
  datos_partido_provincia |> 
  left_join(escannos_provincia_anno, by = c("anno" = "Año", "codigo_provincia" = "codigo_provincia")) |> 
  select(eleccion, codigo_provincia, partido, votos_partido, "Número de escaños")

## Función D'Hondt
dHondt <- function(votos, partidos, escaños) {
  
  # Formato tibble
  tabla <- tibble(partido = partidos, votos = votos)
  
  # Divisores
  divisores <- rep(1, length(votos))
  escaños_asignados <- integer(length(votos))
  
  # Tenemos que repetir el proceso por escaños
  for (i in 1:escaños) {
    # Máximo cociente
    cocientes <- votos / divisores
    max_index <- which.max(cocientes)
    escaños_asignados[max_index] <- escaños_asignados[max_index] + 1
    divisores[max_index] <- divisores[max_index] + 1
  }
  
  # Resultado final
  resultado <- tibble(
    partido = partidos,
    escaños = escaños_asignados
  )
  
  return(resultado)
}


## Función DHondt por provincias

dHondt_provincias <- function(tibble) {
  
  # Inicializamos los resultados
  resultados_dhondt <- tibble()
  
  # Por cada elección de las que tenemos
  for (elec in unique(tibble$eleccion)) {
    # Filtrar por elección actual
    tibble_funcion <- 
      tibble |> 
      filter(eleccion == elec)
    
    # Por cada provincia, ya que cada una tiene unos escaños
    for (provin in unique(tibble_funcion$codigo_provincia)) {
      # Filtrar por provincia actual
      tibble_funcion2 <- 
        tibble_funcion |> 
        filter(codigo_provincia == provin)
      
      # Aplicamos la función de antes
      resultados <- 
        dHondt(
        votos = tibble_funcion2$votos_partido, 
        partidos = tibble_funcion2$partido, 
        escaños = unique(tibble_funcion2$`Número de escaños`)
      )
      
      # Añadimos qué elección es y provincia
      resultados <- 
        resultados |> 
        mutate(eleccion = elec, 
               codigo_provincia = provin)
      
      # Añadimos a la inicialización
      resultados_dhondt <- bind_rows(resultados_dhondt, resultados)
    }
  }
  
  return(resultados_dhondt)
}

resultado_dhondt <-
  dHondt_provincias(datos_provincia_escannos) 
# |> 
#   group_by(eleccion, partido) |> 
#   summarise(sum(escaños)) |> 
#   write.csv(file = "escaños_partidos.csv")


congreso <- 
  resultado_dhondt |> 
  rowwise() |> 
  mutate(partido = cambia_nombres(partido, nombres = nombres_partidos)) |>
  ungroup() |> 
  mutate(siglas = case_when(
            partido == "PARTIDO SOCIALISTA OBRERO ESPAÑOL" ~ "PSOE",
            partido == "PARTIDO POPULAR" ~ "PP",
            partido == "CIUDADANOS" ~ "C's",
            partido == "BLOQUE NACIONALISTA GALLEGO" ~ "BNG",
            partido == "ESQUERRA REPUBLICANA DE CATALUNYA" ~ "ERC",
            partido == "UNIDAS PODEMOS - IU" ~ "PODEMOS-IU",
            partido == "EH - BILDU" ~ "EH-BILDU",
            partido == "PARTIDO NACIONALISTA VASCO" ~ "PNV",
            partido == "VOX" ~ "VOX",
            TRUE ~ "OTRO" )) |> 
   group_by(siglas, eleccion) |> 
   summarise(escannos = sum(escaños)) |> 
     ungroup() #|> 
  #arrange(eleccion, escannos)

congreso <- 
  congreso |> 
  mutate(siglas = factor(siglas, 
                         levels = unique(congreso$siglas), 
                         labels = c("BNG", "C's", "EH-BILDU", "ERC", "OTRO", "PNV", "PODEMOS-IU", "PP", "PSOE", "VOX"), 
                         ordered = TRUE))

Code

## Gráfico de congreso

# Tenemos que filtar por años, porque la geometria geom_parliament() da problemas
# con las leyends de colores/relleno con los facet wrap si los niveles de las 
# leyendas no son exactamente los mismos siempre.

# 2008 #

congreso_2008 <-
congreso |> 
           filter(eleccion == "2008")

# congreso_2008 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2008 <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "6" = "#308444", # PNV 
  "5" = "#808080", # OTRO 
  "7" = "#308444", # PNV
  "10" = "#308444", # PNV
  "4" = "#FFD700", #ERC
  "3" = "#76b3dd",
  "1" = "#76b3dd"
  )

congreso_2008_g <- 
  ggplot(congreso_2008)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2008) +
  scale_color_manual(values = colores_2008) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  

congreso_2008_t <-
  congreso_2008 |> 
  filter(eleccion == "2008" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2008_tg <- 
  ggplot(congreso_2008_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso1 <- grid.arrange(congreso_2008_g, congreso_2008_tg, ncol = 2,
             top = textGrob("2008", gp = gpar(fontsize = 12, fontface = "bold") 
  ))

Code

# 2011 #

congreso_2011 <-
congreso |> 
           filter(eleccion == "2011")

# congreso_2011 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2011 <- c(
  "6" = "#17589d", # PP
  "7" = "#c20e1a", # SOE
  "5" = "#308444", # PNV
  "4" = "#308444", # PNV 
  "3" = "#808080", # OTRO 
  "2" = "#fcc34e", # ERC
  "1" = "#76b3dd" #BNG
)

congreso_2011_g <- 
  ggplot(congreso_2011)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2011) +
  scale_color_manual(values = colores_2011) +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  guides(color = "none", fill = "none") +
  coord_fixed()
  

congreso_2011_t <-
  congreso_2011 |> 
  filter(eleccion == "2011" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2011_tg <- 
  ggplot(congreso_2011_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso2 <- grid.arrange(congreso_2011_g, congreso_2011_tg, ncol = 2,
             top = textGrob("2011", gp = gpar(fontsize = 12, fontface = "bold") ))

Code

# 2015 #

congreso_2015 <-
congreso |> 
           filter(eleccion == "2015")
# 
# congreso_2015 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2015 <- c(
  "7" = "#17589d", # PP
  "8" = "#c20e1a", # SOE
  "9" = "#c20e1a", # SOE
  "6" = "#6b1f5f", # Podemos
  "1" = "#fb5000", # Cs
  "4" = "#808080", # OTRO 
  "3" = "#fcc34e", # ERC
  "2" = "#1af7db", # PNV 
  "5" = "#006400" #BILDU
)

congreso_2015_g <- 
  ggplot(congreso_2015)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2015) +
  scale_color_manual(values = colores_2015) +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  guides(color = "none", fill = "none") +
  coord_fixed()
  


congreso_2015_t <-
  congreso_2015 |> 
  filter(eleccion == "2015" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2015_tg <- 
  ggplot(congreso_2015_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso3 <- grid.arrange(congreso_2015_g, congreso_2015_tg, ncol = 2,
             top = textGrob("2015", gp = gpar(fontsize = 12, fontface = "bold") 
  ))

Code

# 2016 #

congreso_2016 <-
congreso |> 
           filter(eleccion == "2016")

# congreso_2016 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2016 <- c(
  "6" = "#17589d", # PP
  "7" = "#c20e1a", # SOE
  "8" = "#c20e1a", # SOE, lo repito porque se quedaba un punto gris
  "5" = "#6b1f5f", # Podemos
  "3" = "#fb5000", # Cs
  "1" = "#808080", # OTRO 
  "4" = "#308444", # PNV 
  "2" = "#1af7db" #BILDU
)

congreso_2016_g <- 
  ggplot(congreso_2016)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2016) +
  scale_color_manual(values = colores_2016) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  


congreso_2016_t <-
  congreso_2016 |> 
  filter(eleccion == "2016" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2016_tg <- 
  ggplot(congreso_2016_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso4 <- grid.arrange(congreso_2016_g, congreso_2016_tg, ncol = 2,
             top = textGrob("2016", gp = gpar(fontsize = 12, fontface = "bold") ))

Code

# "2019 (abril)"  #

congreso_2019a <-
congreso |> 
           filter(eleccion == "2019 (abril)" )

# congreso_2019a |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2019a <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "7" = "#6b1f5f", # Podemos
  "2" = "#fb5000", # Cs
  "5" = "#808080", # OTRO 
  "6" = "#308444", # PNV 
  "3" = "#1af7db", #BILDU
  "10" = "#5ac035", #VOX
  "4" = "#fcc34e" # ERC
)

congreso_2019a_g <- 
  ggplot(congreso_2019a)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2019a) +
  scale_color_manual(values = colores_2019a) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA))+
  coord_fixed()
  

congreso_2019a_t <-
  congreso_2019a |> 
  filter(eleccion == "2019 (abril)" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2019a_tg <- 
  ggplot(congreso_2019a_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso5 <- grid.arrange(congreso_2019a_g, congreso_2019a_tg, ncol = 2,
             top = textGrob("2019 abril", gp = gpar(fontsize = 12, fontface = "bold")  ))

Code

# "2019 (noviembre)"  #

congreso_2019n <-
congreso |> 
           filter(eleccion == "2019 (noviembre)" )

# congreso_2019n |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2019n <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "7" = "#6b1f5f", # Podemos
  "2" = "#fb5000", # Cs
  "5" = "#808080", # OTRO 
  "6" = "#308444", # PNV 
  "3" = "#1af7db", #BILDU
  "10" = "#5ac035", #VOX
  "4" = "#fcc34e", # ERC
  "1" = "#76b3dd" #BNG
)

congreso_2019n_g <- 
  ggplot(congreso_2019n)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2019n) +
  scale_color_manual(values = colores_2019n) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  
congreso_2019n_t <-
  congreso_2019n |> 
  filter(eleccion == "2019 (noviembre)" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos)

congreso_2019n_tg <- 
  ggplot(congreso_2019n_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso6 <- grid.arrange(congreso_2019n_g, congreso_2019n_tg, ncol = 2,
             top = textGrob("2019 noviembre", gp = gpar(fontsize = 12, fontface = "bold") ))

Code

grid.arrange(grafico_congreso1, grafico_congreso2, grafico_congreso3, grafico_congreso4, grafico_congreso5, grafico_congreso6, ncol = 2, nrow = 3)

Entrega grupal

Paquetes necesarios

Datos empleados

Parte 1: Depuración de datos

Convertir a tidy data

Depuración nombres de partidos

Encuestas

Resumen de información

Resultados generales de las elecciones

Mapa

Parte 2: Votos en los municipios grandes (>100.000 habitantes)

Parte 2: ¿Qué partido fue el segundo cuando el primero fue el PSOE?

Parte 3

Parte 3: Evolución del Porcentaje de Voto en Relación al Censo por Comunidad Autónoma

Parte 3: ¿Es cierto que determinados partidos ganan en las zonas rurales?

Parte 4

Parte 4

Parte 5

Parte 6